home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / linpklib / spbsl.for < prev    next >
Text File  |  1984-01-06  |  2KB  |  82 lines
  1.       SUBROUTINE SPBSL(ABD,LDA,N,M,B)
  2.       INTEGER LDA,N,M
  3.       REAL ABD(LDA,1),B(1)
  4. C
  5. C     SPBSL SOLVES THE REAL SYMMETRIC POSITIVE DEFINITE
  6. C     BAND SYSTEM  A*X = B
  7. C     USING THE FACTORS COMPUTED BY SPBCO OR SPBFA.
  8. C
  9. C     ON ENTRY
  10. C
  11. C        ABD     REAL(LDA, N)
  12. C                THE OUTPUT FROM SPBCO OR SPBFA.
  13. C
  14. C        LDA     INTEGER
  15. C                THE LEADING DIMENSION OF THE ARRAY  ABD .
  16. C
  17. C        N       INTEGER
  18. C                THE ORDER OF THE MATRIX  A .
  19. C
  20. C        M       INTEGER
  21. C                THE NUMBER OF DIAGONALS ABOVE THE MAIN DIAGONAL.
  22. C
  23. C        B       REAL(N)
  24. C                THE RIGHT HAND SIDE VECTOR.
  25. C
  26. C     ON RETURN
  27. C
  28. C        B       THE SOLUTION VECTOR  X .
  29. C
  30. C     ERROR CONDITION
  31. C
  32. C        A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS
  33. C        A ZERO ON THE DIAGONAL.  TECHNICALLY THIS INDICATES
  34. C        SINGULARITY BUT IT IS USUALLY CAUSED BY IMPROPER SUBROUTINE
  35. C        ARGUMENTS.  IT WILL NOT OCCUR IF THE SUBROUTINES ARE CALLED
  36. C        CORRECTLY AND  INFO .EQ. 0 .
  37. C
  38. C     TO COMPUTE  INVERSE(A) * C  WHERE  C  IS A MATRIX
  39. C     WITH  P  COLUMNS
  40. C           CALL SPBCO(ABD,LDA,N,RCOND,Z,INFO)
  41. C           IF (RCOND IS TOO SMALL .OR. INFO .NE. 0) GO TO ...
  42. C           DO 10 J = 1, P
  43. C              CALL SPBSL(ABD,LDA,N,C(1,J))
  44. C        10 CONTINUE
  45. C
  46. C     LINPACK.  THIS VERSION DATED 08/14/78 .
  47. C     CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
  48. C
  49. C     SUBROUTINES AND FUNCTIONS
  50. C
  51. C     BLAS SAXPY,SDOT
  52. C     FORTRAN MIN0
  53. C
  54. C     INTERNAL VARIABLES
  55. C
  56.       REAL SDOT,T
  57.       INTEGER K,KB,LA,LB,LM
  58. C
  59. C     SOLVE TRANS(R)*Y = B
  60. C
  61.       DO 10 K = 1, N
  62.          LM = MIN0(K-1,M)
  63.          LA = M + 1 - LM
  64.          LB = K - LM
  65.          T = SDOT(LM,ABD(LA,K),1,B(LB),1)
  66.          B(K) = (B(K) - T)/ABD(M+1,K)
  67.    10 CONTINUE
  68. C
  69. C     SOLVE R*X = Y
  70. C
  71.       DO 20 KB = 1, N
  72.          K = N + 1 - KB
  73.          LM = MIN0(K-1,M)
  74.          LA = M + 1 - LM
  75.          LB = K - LM
  76.          B(K) = B(K)/ABD(M+1,K)
  77.          T = -B(K)
  78.          CALL SAXPY(LM,T,ABD(LA,K),1,B(LB),1)
  79.    20 CONTINUE
  80.       RETURN
  81.       END
  82.